home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / fortran / linpklib.zip / SPOFA.FOR < prev    next >
Text File  |  1984-01-06  |  2KB  |  73 lines
  1.       SUBROUTINE SPOFA(A,LDA,N,INFO)
  2.       INTEGER LDA,N,INFO
  3.       REAL A(LDA,1)
  4. C
  5. C     SPOFA FACTORS A REAL SYMMETRIC POSITIVE DEFINITE
  6. C     MATRIX.
  7. C
  8. C     SPOFA IS USUALLY CALLED BY SPOCO, BUT IT CAN BE CALLED
  9. C     DIRECTLY WITH A SAVING IN TIME IF  RCOND  IS NOT NEEDED.
  10. C     (TIME FOR SPOCO) = (1 + 18/N)*(TIME FOR SPOFA) .
  11. C
  12. C     ON ENTRY
  13. C
  14. C        A       REAL(LDA, N)
  15. C                THE SYMMETRIC MATRIX TO BE FACTORED.  ONLY THE
  16. C                DIAGONAL AND UPPER TRIANGLE ARE USED.
  17. C
  18. C        LDA     INTEGER
  19. C                THE LEADING DIMENSION OF THE ARRAY  A .
  20. C
  21. C        N       INTEGER
  22. C                THE ORDER OF THE MATRIX  A .
  23. C
  24. C     ON RETURN
  25. C
  26. C        A       AN UPPER TRIANGULAR MATRIX  R  SO THAT  A = TRANS(R)*R
  27. C                WHERE  TRANS(R)  IS THE TRANSPOSE.
  28. C                THE STRICT LOWER TRIANGLE IS UNALTERED.
  29. C                IF  INFO .NE. 0 , THE FACTORIZATION IS NOT COMPLETE.
  30. C
  31. C        INFO    INTEGER
  32. C                = 0  FOR NORMAL RETURN.
  33. C                = K  SIGNALS AN ERROR CONDITION.  THE LEADING MINOR
  34. C                     OF ORDER  K  IS NOT POSITIVE DEFINITE.
  35. C
  36. C     LINPACK.  THIS VERSION DATED 08/14/78 .
  37. C     CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB.
  38. C
  39. C     SUBROUTINES AND FUNCTIONS
  40. C
  41. C     BLAS SDOT
  42. C     FORTRAN SQRT
  43. C
  44. C     INTERNAL VARIABLES
  45. C
  46.       REAL SDOT,T
  47.       REAL S
  48.       INTEGER J,JM1,K
  49. C     BEGIN BLOCK WITH ...EXITS TO 40
  50. C
  51. C
  52.          DO 30 J = 1, N
  53.             INFO = J
  54.             S = 0.0E0
  55.             JM1 = J - 1
  56.             IF (JM1 .LT. 1) GO TO 20
  57.             DO 10 K = 1, JM1
  58.                T = A(K,J) - SDOT(K-1,A(1,K),1,A(1,J),1)
  59.                T = T/A(K,K)
  60.                A(K,J) = T
  61.                S = S + T*T
  62.    10       CONTINUE
  63.    20       CONTINUE
  64.             S = A(J,J) - S
  65. C     ......EXIT
  66.             IF (S .LE. 0.0E0) GO TO 40
  67.             A(J,J) = SQRT(S)
  68.    30    CONTINUE
  69.          INFO = 0
  70.    40 CONTINUE
  71.       RETURN
  72.       END
  73.